home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / COBOL / H309.ZIP / COBXREF.ZIP / COBXRF.EXE / PROGRAM.CBL < prev    next >
Text File  |  1993-05-25  |  17KB  |  518 lines
  1. 000002 IDENTIFICATION DIVISION.
  2. 000003 PROGRAM-ID. ICL8TRMXPROG.
  3. 000004*
  4. 000005*AUTHOR                          N H JENNINGS.
  5. 000006*COPYRIGHT                       TRANTOR Ltd.
  6. 000007*
  7.       *
  8.       *   Part of a MANTIS cross reference program for ICL VME
  9.       *   This module converts a MANTIS program from internal
  10.       *   tokenised format into source lines.
  11.       *   It is an inverted program which returns one source line at a
  12.       *   time to the calling program.
  13.       *   It was created by COBFORM from a structured original.
  14.       *
  15. 000008 ENVIRONMENT DIVISION.
  16. 000009 CONFIGURATION SECTION.
  17. 000010*
  18. 000011 SOURCE-COMPUTER. ICL-2900.
  19. 000012 OBJECT-COMPUTER. ICL-2900.
  20. 000013 SPECIAL-NAMES. SYSICL8TRCTRLKEY IS ICL8TRCTRLKEY,
  21. 000014/
  22. 000015     .
  23. 000016 DATA DIVISION.
  24. 000017 WORKING-STORAGE SECTION.
  25. 000018 01  DISP-ITEM.
  26. 000019     03  DISP-X                  PIC X
  27. 000020                                 OCCURS 40.
  28. 000021
  29. 000022 01  ICL8TRMXPROG-WS.
  30. 000023     03  WC-ENTITY               PIC S9(4) COMP.
  31. 000024     03  WD.
  32. 000025         05  WD-NUMBER           PIC -(18).
  33. 000026         05  WD-NUM          REDEFINES WD-NUMBER.
  34. 000027             07  WD-DIGIT        PIC X
  35. 000028                                 OCCURS 18.
  36. 000029
  37. 000030         05  WD-BINARY           PIC S9(17) COMP.
  38. 000031         05  WD-GROUP        REDEFINES WD-BINARY.
  39. 000032             07  WD-E            PIC X.
  40. 000033             07  WD-F            PIC X.
  41. 000034             07  WD-G            PIC X.
  42. 000035             07  WD-H            PIC X.
  43. 000036             07  WD-A            PIC X.
  44. 000037             07  WD-B            PIC X.
  45. 000038             07  WD-C            PIC X.
  46. 000039             07  WD-D            PIC X.
  47. 000040         05  WD-FLOAT        REDEFINES WD-BINARY COMP-2.
  48. 000041         05  WD-SHORT        REDEFINES WD-FLOAT.
  49. 000042             07  FILLER          PIC X(4).
  50. 000043             07  WD-SHORT-FLOAT COMP-1.
  51. 000044     03  WD-MORE.
  52. 000045         05  WD-DISP-FLOAT       PIC +V9(16)E+99.
  53. 000046         05  WD-XX           REDEFINES WD-DISP-FLOAT.
  54. 000047             07  WD-FIXNUM       PIC 9(17).
  55. 000048             07  FILLER      REDEFINES WD-FIXNUM.
  56. 000049                 09  WD-DATA-SIGN
  57. 000050                                 PIC X.
  58. 000051                 09  WD-FILLER   PIC 9(16).
  59. 000052
  60. 000053             07  FILLER          PIC X.
  61. 000054             07  WD-SIGN         PIC X.
  62. 000055             07  WD-MANT         PIC 99.
  63. 000056         05  WD-FIXED        REDEFINES WD-XX.
  64. 000057             07  WD-FDIGIT       PIC X
  65. 000058                                 OCCURS 21.
  66. 000059     03  WD-RESULT.
  67. 000060         05  WD-X                PIC X
  68. 000061                                 OCCURS 78.
  69. 000062
  70. 000063     03  WD-EXTERNAL.
  71. 000064         05  WD-CHAR             PIC X
  72. 000065                                 OCCURS 18.
  73. 000066     03  WE-VAL.
  74. 000067         05  WE-DISP             PIC 999.
  75. 000068     03  WF-STACK-AREA.
  76. 000069         05  WF-PTR              PIC S9(9) COMP SYNC.
  77. 000070         05  WF-STACK.
  78. 000071             07  WF-TYPE         PIC X(8)
  79. 000072                                 OCCURS 50.
  80. 000073     03  WK-CHECK.
  81. 000074         05  WK-VAL              PIC S9(4) COMP.
  82. 000075         05  WK-BYTES        REDEFINES WK-VAL.
  83. 000076             07                  PIC X.
  84. 000077             07  WK-BYTE         PIC X.
  85. 000078     03  WK-DOT                  PIC X.
  86. 000079     03  WK-COBNAME              PIC X(32).
  87. 000080     03  WK-STATUS               PIC X(32).
  88. 000081     03  WK-KEY.
  89. 000082         05  WK-USER-CODE        PIC 1(8) COMP-5.
  90. 000083         05  WK-ENTITY           PIC S9(4) COMP.
  91. 000084         05  WK-ITEM             PIC X(32).
  92. 000085         05  WK-LV               PIC X.
  93. 000086     03  DUMMY                   PIC S9(4) COMP.
  94. 000087     03  CURRENT-ENTITY          PIC S9(4) COMP.
  95. 000088     03  CURRENT-USER            PIC 1(8) COMP-5.
  96. 000089     03  ENTITY-SUBSCRIPT        PIC S9(4) COMP.
  97. 000090     03  WK-FIELD-SIZE           PIC S9(9) COMP SYNC.
  98. 000091     03  WS-EOD                  PIC S9(9) COMP SYNC.
  99. 000092     03  REC-NO                  PIC S9(9) COMP SYNC.
  100. 000093     03  REC-PTR                 PIC S9(9) COMP SYNC.
  101. 000094     03  B-PSV                   PIC S9(9) COMP SYNC
  102. 000095                                               VALUE 1.
  103. 000096     03  I                       PIC S9(9) COMP SYNC.
  104. 000097     03  J                       PIC S9(9) COMP SYNC.
  105. 000098     03  K                       PIC S9(9) COMP SYNC.
  106. 000099     03  L                       PIC S9(9) COMP SYNC.
  107. 000100     03  LK-WHEN                 PIC S9(9) COMP SYNC.
  108. 000101     03  LK-PTR                  PIC S9(9) COMP SYNC.
  109. 000102     03  LK-OFFSET               PIC S9(9) COMP SYNC.
  110. 000103     03  WS-SIZE                 PIC S9(9) COMP SYNC.
  111. 000104     03  WS-INDENT               PIC S9(9) COMP SYNC.
  112. 000105     03  WS-LEN                  PIC S9(9) COMP SYNC.
  113. 000106     03  WS-END                  PIC S9(9) COMP SYNC.
  114. 000107     03  Z-ERROR                 PIC S9(9) COMP SYNC.
  115. 000108     03  WS-TOKEN-PTR            PIC S9(9) COMP SYNC.
  116. 000109     03  WS-EXTRA-TOKEN          PIC S9(9) COMP SYNC.
  117. 000110     03  WS-POINTER              PIC S9(9) COMP SYNC.
  118. 000111     03  WS-DATA-POINTER         PIC S9(9) COMP SYNC.
  119. 000112     03  WK-TYPE                 PIC X.
  120. 000113     03  WK-RESULT               PIC S9(9) COMP SYNC.
  121. 000114     03  WS-WK                   PIC S9(9) COMP SYNC.
  122. 000115     03  WS-HEX.
  123. 000116         05  WS-OFFSET           PIC S9(4) COMP.
  124. 000117         05  WS-DATATYPE         PIC 1(8) COMP-5.
  125. 000118         05  WS-LENGTH           PIC 1(8) COMP-5.
  126. 000119         05  WS-OCCURS           PIC 1(8) COMP-5.
  127. 000120         05  WS-VO               PIC 1(8) COMP-5.
  128. 000121         05  WS-HO               PIC 1(8) COMP-5.
  129. 000122         05  FILLER              PIC X(1).
  130. 000123     03  WS-TEMP.
  131. 000124         05  WS-TYPE             PIC X(10).
  132. 000125         05  WS-NAME             PIC X(20).
  133. 000126         05  FILLER              PIC X.
  134. 000127         05  WS-LINE             PIC 999.
  135. 000128         05  FILLER              PIC X.
  136. 000129         05  WS-COL              PIC 99.
  137. 000130         05  FILLER              PIC X.
  138. 000131         05  WS-DATA             PIC X(20).
  139. 000132     03  CURRENT-VAL.
  140. 000133         05  X                   PIC S9(4) COMP.
  141. 000134         05  FILLER          REDEFINES X.
  142. 000135             07  FILLER          PIC X.
  143. 000136             07  Y               PIC X.
  144. 000137     03  WK-FUNCTION             PIC X.
  145. 000138     03  WS-WORK.
  146. 000139         05  WS-SYS1-X.
  147. 000140             07  WS-SYS1         PIC 1(8) COMP-5.
  148. 000141         05  WS-USER-X.
  149. 000142             07  WS-USER         PIC 1(8) COMP-5.
  150. 000143     03  NEXT-KEY                PIC X(36).
  151. 000144     03  WS-CTRL                 PIC X.
  152. 000145     03  CALLED-MODULES.
  153. 000146         05  READ-CLUSTER        PIC X(20)     VALUE
  154. 000147                                                 "ICL8TRMXREADCL".
  155. 000148
  156. 000149
  157. 000150 01  WK-RECORD.
  158. 000151     03  RM-RECORD.
  159. 000152         05  ENT-HDR.
  160. 000153             07  RM-KEY.
  161. 000154                 09  MAIN-KEY.
  162. 000155                   11  RM-USER   PIC 1(8) COMP-5.
  163. 000156                   11  RM-ENTITY PIC S9(4) COMP.
  164. 000157                   11  RM-ITEM   PIC X(32).
  165. 000158                   11  RM-LV     PIC 1(8) COMP-5.
  166. 000159         05  REST-REC.
  167. 000160             07  REST-VAL        PIC 1(8) COMP-5
  168. 000161                                 OCCURS 31964.
  169. 000162     03  CLUST-REC           REDEFINES RM-RECORD.
  170. 000163         05  CLUST-BYTE          OCCURS 32000.
  171. 000164             07  CLUST-VAL       PIC 1(8) COMP-5.
  172. 000165 01  WS-STRING.
  173. 000166     03  WS-X                    PIC X
  174. 000167                                 OCCURS 0 TO 100 DEPENDING ON
  175. 000168           WS-SIZE.
  176. 000169
  177. 000170
  178. 000171 LINKAGE SECTION.
  179. 000172 01  LK-USER                     PIC X(16).
  180. 000173 01  LK-TYPE                     PIC X(12).
  181. 000174 01  LK-NAME-FROM                PIC X(32).
  182. 000175 01  LK-NAME-TO                  PIC X(32).
  183. 000176 01  LK-INDICATOR                PIC X.
  184. 000177     COPY COPYPC.
  185. 000178
  186. 000179
  187. 000180 01  LK-NAME-OUT                 PIC X(32).
  188. 000181 01  LK-DESC                     PIC X(60).
  189. 000182 01  LK-ITEM.
  190. 000183     03  LK-CHAR                 PIC X
  191. 000184                                 OCCURS 500.
  192. 000185 01  LK-RESULT                   PIC S9(9) COMP SYNC.
  193. 000186 PROCEDURE DIVISION USING LK-USER,
  194. 000187             LK-TYPE,
  195. 000188             LK-NAME-FROM,
  196. 000189             LK-NAME-TO,
  197. 000190             LK-INDICATOR,
  198. 000191             LK-PROG-CONTROL,
  199. 000192             LK-NAME-OUT,
  200. 000193             LK-DESC,
  201. 000194             LK-ITEM,
  202. 000195             LK-RESULT.
  203. 000196/
  204. 000197 A-MAIN SECTION.
  205. 000198 AAA-START.
  206. 000199     PERFORM B-INVERTED
  207. 000200     EXIT PROGRAM.
  208. 000201 AAA-EPROC.
  209. 000202     EXIT.
  210. 000203**
  211. 000204*
  212. 000205
  213. 000206/
  214. 000207 B-INVERTED SECTION.
  215. 000208 BAA-START.
  216. 000209     GO TO BAA-JUMP-TABLE.
  217. 000210 BAA-0001.
  218. 000211 BBA-POSIT.
  219. 000212     IF  LK-USER = "CONTROL"
  220. 000213        MOVE ZERO TO WS-USER
  221. 000214     ELSE
  222. 000215        PERFORM SYSTEM-RECORD.
  223. 000216     MOVE LKP-DOT TO WK-DOT.
  224. 000217     MOVE 2 TO CURRENT-ENTITY
  225. 000218     MOVE 0 TO LK-INDICATOR
  226. 000219     MOVE SPACES TO LK-NAME-OUT,
  227. 000220             LK-DESC,
  228. 000221             LK-ITEM
  229. 000222     MOVE LOW-VALUES TO WK-KEY
  230. 000223     MOVE LK-NAME-FROM TO WK-ITEM
  231. 000224     MOVE WS-USER TO WK-USER-CODE,
  232. 000225             CURRENT-USER
  233. 000226     MOVE CURRENT-ENTITY TO WK-ENTITY
  234. 000227     MOVE WK-KEY TO RM-KEY
  235. 000228     MOVE "S" TO WK-FUNCTION
  236. 000229     PERFORM E-READ-RECORD
  237. 000230     IF  WK-RESULT NOT = 0
  238. 000231        GO TO BBA-ADMIT.
  239. 000232 BCA-UNTIL.
  240. 000233     IF RM-ENTITY NOT = CURRENT-ENTITY
  241. 000234            OR RM-USER NOT = CURRENT-USER
  242. 000235            OR RM-ITEM > LK-NAME-TO
  243. 000236     THEN
  244. 000237        GO TO BCA-END.
  245. 000238     MOVE SPACES TO LK-NAME-OUT
  246. 000239     UNSTRING RM-ITEM DELIMITED LOW-VALUES INTO LK-NAME-OUT
  247. 000241     MOVE 54 TO WS-POINTER
  248. 000242     PERFORM UN-STRING
  249. 000243     MOVE WS-STRING TO LK-DESC
  250. 000244     MOVE 0 TO LK-OFFSET,
  251. 000245             LK-WHEN
  252. 000246     PERFORM G-END-POINTER
  253. 000247     MOVE 0 TO X
  254. 000248     MOVE CLUST-BYTE(WS-POINTER) TO Y.
  255. 000249 BDA-UNTIL.
  256. 000250     IF X > 190
  257. 000251            OR WS-POINTER > 32000
  258. 000252     THEN
  259. 000253        GO TO BDA-END.
  260. 000254     PERFORM S-KEYCHECK
  261. 000255     PERFORM R-DECODE
  262. 000256     MOVE 0002 TO B-PSV.
  263. 000257     GO TO BAA-EPROC.
  264. 000258 BAA-0002.
  265. 000259     IF  WS-POINTER < 32000
  266. 000260        MOVE 0 TO X
  267. 000261        MOVE CLUST-BYTE(WS-POINTER) TO Y
  268. 000262     ELSE
  269. 000263        MOVE 255 TO X.
  270. 000264     GO TO BDA-UNTIL.
  271. 000265 BDA-END.
  272. 000266     MOVE 1 TO LK-INDICATOR
  273. 000267     MOVE 0003 TO B-PSV.
  274. 000268     GO TO BAA-EPROC.
  275. 000269 BAA-0003.
  276. 000270     MOVE "N" TO WK-FUNCTION
  277. 000271     PERFORM E-READ-RECORD
  278. 000272     GO TO BCA-UNTIL.
  279. 000273 BCA-END.
  280. 000274     MOVE 2 TO LK-INDICATOR
  281. 000275     MOVE "C" TO WK-FUNCTION
  282. 000276     PERFORM E-READ-RECORD
  283. 000277     IF  WK-RESULT NOT = 0
  284. 000278        GO TO BBA-ADMIT.
  285. 000279     MOVE 0 TO LK-RESULT
  286. 000280     GO TO BBA-END.
  287. 000281 BBA-ADMIT.
  288. 000282     MOVE WK-RESULT TO LK-RESULT.
  289. 000283 BBA-END.
  290. 000284     MOVE 1 TO B-PSV.
  291. 000285     GO TO BAA-EPROC.
  292. 000286 BAA-JUMP-TABLE.
  293. 000287     IF B-PSV < 1
  294. 000288            OR > 0004
  295. 000289     THEN
  296. 000290        MOVE 1 TO B-PSV.
  297. 000291     GO TO BAA-0001,
  298. 000292             BAA-0002,
  299. 000293             BAA-0003,
  300. 000294             BAA-0004,
  301. 000295             DEPENDING ON B-PSV.
  302. 000296 BAA-0004.
  303. 000297 BAA-EPROC.
  304. 000298     EXIT.
  305. 000299**
  306. 000300*
  307. 000301/
  308. 000302 E-READ-RECORD SECTION.
  309. 000303 CAA-START.
  310. 000304     CALL READ-CLUSTER USING WK-KEY,
  311. 000305             WK-FUNCTION,
  312. 000306             WK-RECORD,
  313. 000307             WK-RESULT.
  314. 000308 CAA-EPROC.
  315. 000309     EXIT.
  316. 000310**
  317. 000311*
  318. 000312
  319. 000313/
  320. 000314 G-END-POINTER SECTION.
  321. 000315 DAA-START.
  322. 000316     MOVE WS-POINTER TO WS-END
  323. 000317     PERFORM H-NUMBER
  324. 000318     COMPUTE WS-EXTRA-TOKEN = WD-BINARY + WS-END + 3
  325. 000319     PERFORM H-NUMBER
  326. 000320     COMPUTE WS-TOKEN-PTR = WD-BINARY + WS-END + 5
  327. 000321     PERFORM H-NUMBER.
  328. 000322 DAA-EPROC.
  329. 000323     EXIT.
  330. 000324**
  331. 000325*
  332. 000326
  333. 000327/
  334. 000328 H-NUMBER SECTION.
  335. 000329 EAA-START.
  336. 000330     MOVE 0 TO WD-BINARY
  337. 000331     MOVE CLUST-BYTE(WS-POINTER) TO WD-C
  338. 000332     ADD 1 TO WS-POINTER
  339. 000333     MOVE CLUST-BYTE(WS-POINTER) TO WD-D
  340. 000334     ADD 1 TO WS-POINTER
  341. 000335     PERFORM K-BINTOCHAR.
  342. 000336 EAA-EPROC.
  343. 000337     EXIT.
  344. 000338**
  345. 000339*
  346. 000340
  347. 000341/
  348. 000342 I-DECODE-DATANAME SECTION.
  349. 000343 FAA-START.
  350. 000344     ADD 1 TO WS-POINTER
  351. 000345     ADD I,
  352. 000346             CLUST-VAL(WS-POINTER)
  353. 000347                                 GIVING WK-VAL
  354. 000348     MOVE WS-TOKEN-PTR TO I
  355. 000349     MOVE 1 TO J.
  356. 000350 FBA-UNTIL.
  357. 000351     IF J > WK-VAL
  358. 000352     THEN
  359. 000353        GO TO FBA-END.
  360. 000354     ADD 1 TO I
  361. 000355     IF  CLUST-BYTE(I) = SPACE
  362. 000356        ADD 1 TO J.
  363. 000357     GO TO FBA-UNTIL.
  364. 000358 FBA-END.
  365. 000359     ADD 1 TO I.
  366. 000360 FBB-UNTIL.
  367. 000361     IF CLUST-BYTE(I) = SPACE
  368. 000362            OR LK-PTR > 80
  369. 000363     THEN
  370. 000364        GO TO FBB-END.
  371. 000365     MOVE CLUST-BYTE(I) TO LK-CHAR(LK-PTR)
  372. 000366     ADD 1 TO I,
  373. 000367             LK-PTR
  374. 000368     GO TO FBB-UNTIL.
  375. 000369 FBB-END.
  376. 000370 FAA-EPROC.
  377. 000371     EXIT.
  378. 000372**
  379. 000373*
  380. 000374
  381. 000375
  382. 000376
  383. 000377/
  384. 000378 K-BINTOCHAR SECTION.
  385. 000379 GAA-START.
  386. 000380     MOVE SPACES TO WD-NUM
  387. 000381     MOVE WD-BINARY TO WD-NUMBER
  388. 000382     MOVE 1 TO I,
  389. 000383             J
  390. 000384     MOVE SPACES TO WD-EXTERNAL.
  391. 000385 GBA-UNTIL.
  392. 000386     IF I > 18
  393. 000387     THEN
  394. 000388        GO TO GBA-END.
  395. 000389     IF  WD-DIGIT(I) = SPACE
  396. 000390        ADD 1 TO I
  397. 000391     ELSE
  398. 000392        MOVE WD-DIGIT(I) TO WD-CHAR(J)
  399. 000393        ADD 1 TO I,
  400. 000394             J.
  401. 000395     GO TO GBA-UNTIL.
  402. 000396 GBA-END.
  403. 000397 GAA-EPROC.
  404. 000398     EXIT.
  405. 000399**
  406. 000400*
  407. 000401
  408. 000402/
  409. 000403 M-PLACES SECTION.
  410. 000404 HAA-START.
  411. 000405     MOVE 0 TO WD-RESULT
  412. 000406     MOVE 1 TO I,
  413. 000407             L
  414. 000408     MOVE WD-MANT TO K
  415. 000409     IF  WD-SIGN = "-"
  416. 000410        SUBTRACT K FROM 0        GIVING K.
  417. 000411     IF  WD-DATA-SIGN = "-"
  418. 000412        MOVE "-" TO WD-X(1)
  419. 000413        ADD 1 TO I.
  420. 000414     ADD 5 TO WD-FIXNUM
  421. 000415     IF  WD-DATA-SIGN = 0
  422. 000416        MOVE 2 TO J
  423. 000417     ELSE
  424. 000418        ADD 1 TO K
  425. 000419        MOVE 1 TO J.
  426. 000420 HBA-SELECT.
  427. 000421     IF K < 0
  428. 000422     THEN
  429. 000423        NEXT SENTENCE
  430. 000424     ELSE
  431. 000425        GO TO HBA-TEST-0001.
  432. 000426 HBA-CASE-0001.
  433. 000427     SUBTRACT K FROM 0           GIVING K
  434. 000428     MOVE WK-DOT TO WD-X(1)
  435. 000429     ADD 1 TO I.
  436. 000430 HCA-UNTIL.
  437. 000431     IF L > K
  438. 000432     THEN
  439. 000433        GO TO HCA-END.
  440. 000434     MOVE 0 TO WD-X(I)
  441. 000435     ADD 1 TO I,
  442. 000436             L
  443. 000437     GO TO HCA-UNTIL.
  444. 000438 HCA-END.
  445. 000439 HCB-UNTIL.
  446. 000440     IF I > 78
  447. 000441            OR J > 15
  448. 000442     THEN
  449. 000443        GO TO HCB-END.
  450. 000444     MOVE WD-FDIGIT(J) TO WD-X(I)
  451. 000445     ADD 1 TO I,
  452. 000446             J
  453. 000447     GO TO HCB-UNTIL.
  454. 000448 HCB-END.
  455. 000449     GO TO HBA-END.
  456. 000450 HBA-TEST-0001.
  457. 000451 HCC-UNTIL.
  458. 000452     IF L > K
  459. 000453     THEN
  460. 000454        GO TO HCC-END.
  461. 000455     IF  J NOT > 15
  462. 000456        MOVE WD-FDIGIT(J) TO WD-X(I)
  463. 000457        ADD 1 TO J.
  464. 000458     ADD 1 TO I ,
  465. 000459             L
  466. 000460     GO TO HCC-UNTIL.
  467. 000461 HCC-END.
  468. 000462 HCD-UNTIL.
  469. 000463     IF I > 78
  470. 000464            OR J > 15
  471. 000465     THEN
  472. 000466        GO TO HCD-END.
  473. 000467     MOVE WD-FDIGIT(J) TO WD-X(I)
  474. 000468     ADD 1 TO I,
  475. 000469             J
  476. 000470     GO TO HCD-UNTIL.
  477. 000471 HCD-END.
  478. 000472 HBA-TEST-0002.
  479. 000473 HBA-END.
  480. 000474     MOVE 78 TO I.
  481. 000475 HBB-UNTIL.
  482. 000476     IF WD-X(I) NOT = 0
  483. 000477            OR I < 1
  484. 000478     THEN
  485. 000479        GO TO HBB-END.
  486. 000480     MOVE SPACE TO WD-X(I)
  487. 000481     SUBTRACT 1 FROM I
  488. 000482     GO TO HBB-UNTIL.
  489. 000483 HBB-END.
  490. 000484     IF  WD-X(I) = "."
  491. 000485        MOVE SPACE TO WD-X(I).
  492. 000486 HAA-EPROC.
  493. 000487     EXIT.
  494. 000488**
  495. 000489*
  496. 000490
  497. 000491
  498. 000492
  499. 000493
  500. 000494/
  501. 000495 N-NUMBER SECTION.
  502. 000496 IAA-START.
  503. 000497     MOVE 0 TO WD-BINARY
  504. 000498     MOVE CLUST-BYTE(WS-POINTER) TO WD-A
  505. 000499     ADD 1 TO WS-POINTER
  506. 000500     MOVE CLUST-BYTE(WS-POINTER) TO WD-B
  507. 000501     ADD 1 TO WS-POINTER
  508. 000502     MOVE CLUST-BYTE(WS-POINTER) TO WD-C
  509. 000503     ADD 1 TO WS-POINTER
  510. 000504     MOVE CLUST-BYTE(WS-POINTER) TO WD-D
  511. 000505     ADD 1 TO WS-POINTER
  512. 000506     PERFORM K-BINTOCHAR.
  513. 000507 IAA-EPROC.
  514. 000508     EXIT.
  515. 000509**
  516. 000510*
  517.  
  518.